home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 78 / 64er_Magazin_Sonderheft_78_19xx_Markt__Technik_de_Side_A.d64 / power of logic (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  19KB  |  698 lines
  1. 100 goto 6490
  2. 110 :
  3. 120 n$="power of logic": n$=left$(n$,12)
  4. 130 open 1,8,15,("s:"+n$+".bak"): close 1
  5. 140 open 1,8,15,("r:"+n$+".bak="+n$+".bas"): close 1
  6. 150 save (n$+".bas"),8: verify (n$+".bas"),8
  7. 160 end
  8. 170 :
  9. 180 n$="printercodes": rem  zum drucken run 180
  10. 190 open 1,8,2,(n$+",p,r")
  11. 200 get#1,i$: d1%=asc(i$+chr$(0))
  12. 210 get#1,i$: d2%=asc(i$+chr$(0))
  13. 220 get#1,i$:  i%=asc(i$+chr$(0)): in$=""
  14. 230 if len(in$)<i% then get#1,i$: in$=in$+left$(i$+chr$(0),1): goto 230
  15. 240 get#1,i$: dx%=asc(i$+chr$(0))
  16. 250 get#1,i$: dy%=asc(i$+chr$(0))
  17. 260 get#1,i$: dl%=asc(i$+chr$(0))
  18. 270 get#1,i$: dr%=asc(i$+chr$(0))
  19. 280 get#1,i$: do%=asc(i$+chr$(0))
  20. 290 get#1,i$: du%=asc(i$+chr$(0))
  21. 300 ct=52224
  22. 310 for i=0 to 255
  23. 320 : get#1,i$: poke ct+i,asc(i$+chr$(0))
  24. 330 next i
  25. 340 close 1
  26. 350 open 2,d1%,d2%: print#2,in$;
  27. 360 pr%=-1: cr$=chr$(13)
  28. 370 if dz%<do% then print#2,cr$;: dz%=dz%+1: goto 370
  29. 380 print#2,left$(l$,dl%);: goto 6490
  30. 390 :
  31. 400 rem input
  32. 410 :
  33. 420 i$="":p%=1: goto 440
  34. 430 print t$;
  35. 440 print "";mid$(i$+" ",p%,1);"[157]";
  36. 450 get t$: if t$="" then 450
  37. 460 print "[146]";mid$(i$+" ",p%,1);"[157]";: a=asc(t$)
  38. 470 if p%<41 then if t$=" " or (t$>="#" and t$<="z") then 540
  39. 480 if p%<41 then if (t$>="[193]" and t$<="[218]") then 540
  40. 490 if t$="" and p%<=len(i$) then p%=p%+1: goto 430
  41. 500 if t$="[157]" and p%>1 then p%=p%-1: goto 430
  42. 510 if a=20 and p%>1 then 560
  43. 520 if a=13 then pr$=i$+chr$(13):print : goto 630
  44. 530 goto 440
  45. 540 if p%=len(i$)+1 then i$=i$+t$: p%=p%+1: goto 430
  46. 550 i$=left$(i$,p%-1)+t$+right$(i$,len(i$)-p%): p%=p%+1: goto 430
  47. 560 i$=left$(i$,p%-2)+right$(i$,len(i$)-p%+1): p%=p%-1: goto 430
  48. 570 :
  49. 580 rem drucke
  50. 590 :
  51. 600 pr$=chr$(13): goto 620
  52. 610 pr$=pr$+chr$(13)
  53. 620 st$=ti$: print pr$;
  54. 630 if pr%=0 then return
  55. 640 pr%=1
  56. 650 if pr%>len(pr$) then return
  57. 660 : q$=mid$(pr$,pr%,1): if q$=c1$ or q$=c2$ then 780
  58. 670 : c%=peek(ct+asc(q$))
  59. 680 : print#2,chr$(c%);
  60. 690 : if c%<>13 then 780
  61. 700 :   dz%=dz%+1
  62. 710 :   if dz%>=dy%-du% and dz%<dy% then print#2,cr$;: dz%=dz%+1: goto 710
  63. 720 :   if dz%<dy% then 770
  64. 730 :     ds%=ds%+1: dz%=dz%-dy%
  65. 740 :     print ds%;"[211]eite(n) voll - [212]aste!"
  66. 750 :     get q$: if q$="" then 750
  67. 760 :     if dz%<do% then print#2,cr$;: dz%=dz%+1: goto 760
  68. 770 :   print#2,left$(l$,dl%);
  69. 780 pr%=pr%+1: goto 650
  70. 790 ti$=st$: return
  71. 800 :
  72. 810 rem dimensioniere
  73. 820 :
  74. 830 ml=8: w$=left$("[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]",ml)
  75. 840 l$="                                        "
  76. 850 rem def fnpt(x)=int(2^(x-1)+.001)
  77. 860 def fnlg(x)=log(x)/log(2)+1.0005
  78. 870 def fnpl(x)=(x=1orx=2orx=4orx=8orx=16orx=32orx=64orx=128orx=256orx=512)
  79. 880 q=0:z1=0:z2=0:a=0:b=0:c=0:w=0:i=0:f=0:f1=0
  80. 890 :
  81. 900 sm%=12: zm%=10: rem maximalwerte
  82. 910 dim pt%(zm%+1)
  83. 920 dim f$(sm%),b$(sm%,zm%): rem oberbegriffe, objekte
  84. 930 qm%=.5*sm%*(sm%-1): rem quadrate
  85. 940 dim bx%(qm%,zm%),by%(qm%,zm%),ex%(qm%,zm%),ey%(qm%,zm%)
  86. 950 rm%=20: rem max. relative beziehungen
  87. 960 dim ro%(rm%),rp%(rm%),r1%(rm%,1),r2%(rm%,1),k%(2*zm%,1),kb%(2*zm%),ko%(sm%)
  88. 970 dim s1%(qm%),s2%(qm%)
  89. 980 dim q%(sm%,sm%)
  90. 990 return
  91. 1000 :
  92. 1010 rem initialisiere
  93. 1020 :
  94. 1030 q%=1: for e=1 to zm%+1: pt%(e)=q%: q%=q%*2: next e
  95. 1040 qm%=.5*sm%*(sm%-1): rem quadrate
  96. 1050 bw%=pt%(zm%+1)-1
  97. 1060 rem oberbegriffe s1% und s2% von quadrat q%
  98. 1070 q%=0
  99. 1080 for y=sm% to 2 step-1
  100. 1090 : for x=1 to y-1
  101. 1100 :   q%=q%+1: s1%(q%)=x: s2%(q%)=y
  102. 1110 next x,y
  103. 1120 rem quadrat q% von oberbegriffen s1 und s2
  104. 1130 for s1=0 to sm%
  105. 1140 : for s2=0 to sm%
  106. 1150 :   q%(s1,s2)=-1
  107. 1160 :   if s1<s2 then q%(s1,s2)=s1+(sm%-s2)*sm%-0.5*(sm%-s2)*(sm%-s2+1)
  108. 1170 :   if s1>s2 then q%(s1,s2)=s2+(sm%-s1)*sm%-0.5*(sm%-s1)*(sm%-s1+1)
  109. 1180 next s2,s1
  110. 1190 return
  111. 1200 :
  112. 1210 rem speichere
  113. 1220 :
  114. 1230 pr$="[196]ateiname? ": gosub 620: gosub 420: if i$="" then return
  115. 1240 n$=i$+".log"
  116. 1250 open 1,8,15,("s:"+n$): close 1
  117. 1260 open 1,8,2,n$+",s,w"
  118. 1270 print#1,sm%: print#1,zm%
  119. 1280 for s=1 to sm%: print#1,f$(s)
  120. 1290 : for z=1 to zm%: print#1,b$(s,z)
  121. 1300 next z,s
  122. 1310 for q=1 to qm%
  123. 1320 : for e=1 to zm%
  124. 1330 :   print#1,ex%(q,e): print#1,ey%(q,e)
  125. 1340 :   print#1,bx%(q,e): print#1,by%(q,e)
  126. 1350 next e,q
  127. 1360 print#1,ra%: if ra%=0 then 1420
  128. 1370 for r=1 to ra%
  129. 1380 : print#1,ro%(r): print#1,rp%(r)
  130. 1390 : print#1,r1%(r,0): print#1,r1%(r,1)
  131. 1400 : print#1,r2%(r,0): print#1,r2%(r,1)
  132. 1410 next r
  133. 1420 close 1
  134. 1430 pr$="[196]atei ist gespeichert.": gosub 610
  135. 1440 return
  136. 1450 :
  137. 1460 rem lade
  138. 1470 :
  139. 1480 pr$="[196]ateiname? ": gosub 620: gosub 420: if i$="" then return
  140. 1490 n$=i$+".log"
  141. 1500 open 1,8,2,n$+",s,r"
  142. 1510 input#1,sm%: input#1,zm%
  143. 1520 gosub 1030 initialisiere
  144. 1530 for s=1 to sm%: input#1,f$(s)
  145. 1540 : for z=1 to zm%: input#1,b$(s,z)
  146. 1550 next z,s
  147. 1560 for q=1 to qm%
  148. 1570 : for e=1 to zm%
  149. 1580 :   input#1,ex%(q,e): input#1,ey%(q,e)
  150. 1590 :   input#1,bx%(q,e): input#1,by%(q,e)
  151. 1600 next e,q
  152. 1610 input#1,ra%: if ra%=0 then 1670
  153. 1620 for r=1 to ra%
  154. 1630 : input#1,ro%(r): input#1,rp%(r)
  155. 1640 : input#1,r1%(r,0): input#1,r1%(r,1)
  156. 1650 : input#1,r2%(r,0): input#1,r2%(r,1)
  157. 1660 next r
  158. 1670 close 1
  159. 1680 pr$="[196]atei ist geladen.": gosub 610
  160. 1690 return
  161. 1700 :
  162. 1710 rem lass eingeben
  163. 1720 :
  164. 1730 gosub 600
  165. 1740 pr$="[215]ieviele [199]ruppen (2-12)? ": gosub 620:gosub 420: sm%=val(i$)
  166. 1750 pr$="[215]ieviele [197]inheiten (2-10)? ": gosub 620:gosub 420: zm%=val(i$)
  167. 1760 gosub 1030 initialisiere
  168. 1770 gosub 600
  169. 1780 pr$="[194]itte jetzt die [207]bjekte eingeben": gosub 610
  170. 1790 pr$="- alle unterschiedlich benannt": gosub 610
  171. 1800 pr$="- gegebenenfalls in ihrer natuerlichen": gosub 610
  172. 1810 pr$="  [207]rdnung": gosub 610
  173. 1820 gosub 600
  174. 1830 for s=1 to sm%
  175. 1840 : pr$="[207]berbegriff von [199]ruppe "+chr$(192+s)+" ? ":gosub 620:gosub 420: f$(s)=i$
  176. 1850 : if f$(s)="" then f$(s)=chr$(192+s)
  177. 1860 : pr$="[194]itte"+str$(zm%)+" davon eingeben!": gosub 610
  178. 1870 : for z=1 to zm%
  179. 1880 :   pr$="? ": gosub 620:gosub 420: b$(s,z)=i$
  180. 1890 :   if b$(s,z)="" then b$(s,z)=chr$(64+s)+chr$(48+z)
  181. 1900 : next z
  182. 1910 next s
  183. 1920 for q=1 to qm%
  184. 1930 : for e=1 to zm%
  185. 1940 :   ex%(q,e)=bw%: ey%(q,e)=bw%
  186. 1950 :   bx%(q,e)=bw%: by%(q,e)=bw%
  187. 1960 next e,q
  188. 1970 ra%=0
  189. 1980 return
  190. 1990 :
  191. 2000 rem finde begriffsposition
  192. 2010 :
  193. 2020 s1%=-1
  194. 2030 for s=1 to sm%
  195. 2040 : for z=1 to zm%
  196. 2050 :   if p$=b$(s,z) then s1%=s: z1=z
  197. 2060 next z,s
  198. 2070 if s1%=-1 then pr$=c2$+"[207]bjekt nicht erkannt."+c1$: gosub 610
  199. 2080 return
  200. 2090 :
  201. 2100 rem nenne begriff um
  202. 2110 :
  203. 2120 for s=1 to sm%
  204. 2130 : if f$(s)=b$ then f$(s)=a$: b$=""
  205. 2140 next s
  206. 2150 if b$="" then return
  207. 2160 :
  208. 2170 p$=b$: gosub 2020 begriffsposition
  209. 2180 if s1%=-1 then return
  210. 2190 b$(s1%,z1)=a$: return
  211. 2200 :
  212. 2210 rem gib objekte aus
  213. 2220 :
  214. 2230 gosub 600
  215. 2240 for s=1 to sm%
  216. 2250 : pr$=c2$+f$(s)+c1$: gosub 610
  217. 2260 : for z=1 to zm%
  218. 2270 :   pr$="  "+b$(s,z): gosub 610
  219. 2280 : next z
  220. 2290 next s
  221. 2300 return
  222. 2310 :
  223. 2320 rem nimm beziehung auf
  224. 2330 :
  225. 2340 p$=b$: gosub 2020 begriffsposition
  226. 2350 if s1%=-1 then return
  227. 2360 s2%=s1%:z2=z1
  228. 2370 p$=a$: gosub 2020 begriffsposition
  229. 2380 if s1%=-1 then return
  230. 2390 if k$="+" or k$="-" or k$="?" then 2510
  231. 2400 if s1%=ro% or s2%=ro% then pr$=c2$+"[194]ez. nicht relativ."+c1$: gosub 610: return
  232. 2410 if ra%<rm% then 2440
  233. 2420 pr$=c2$+"[211]peicher fuer relative [194]eziehungen ist": gosub 610
  234. 2430 pr$="voll. [197]ingabe nicht akzeptiert."+c1$: gosub 610: return
  235. 2440 ra%=ra%+1: pr$=str$(ra%)+" relative [194]eziehung(en) vorgemerkt.": gosub 610
  236. 2450 rp%(ra%)=rp%: ro%(ra%)=ro%
  237. 2460 r1%(ra%,0)=s1%: r1%(ra%,1)=z1
  238. 2470 r2%(ra%,0)=s2%: r2%(ra%,1)=z2
  239. 2480 if s1%=s2% then return
  240. 2490 k$="-"
  241. 2500 :
  242. 2510 if s1%=s2% then pr$=c2$+"[194]eziehung nicht verwertbar."+c1$: gosub 610: return
  243. 2520 if s1%>s2% then i%=s1%:s1%=s2%:s2%=i%: i%=z1:z1=z2:z2=i%
  244. 2530 q=q%(s1%,s2%)
  245. 2540 if k$<>"-" then 2570
  246. 2550 ex%(q,z2)=ex%(q,z2) and (bw%-pt%(z1))
  247. 2560 ey%(q,z1)=ey%(q,z1) and (bw%-pt%(z2))
  248. 2570 if k$<>"+" then 2640
  249. 2580 for e=1 to zm%
  250. 2590 : if e=z2 then ex%(q,z2)=pt%(z1)
  251. 2600 : if e<>z2 then ex%(q,e)=ex%(q,e) and (bw%-pt%(z1))
  252. 2610 : if e=z1 then ey%(q,z1)=pt%(z2)
  253. 2620 : if e<>z1 then ey%(q,e)=ey%(q,e) and (bw%-pt%(z2))
  254. 2630 next e
  255. 2640 if k$<>"?" then 2670
  256. 2650 ex%(q,z2)=ex%(q,z2) or pt%(z1)
  257. 2660 ey%(q,z1)=ey%(q,z1) or pt%(z2)
  258. 2670 return
  259. 2680 :
  260. 2690 rem eleminiere rel. bez.
  261. 2700 :
  262. 2710 ra%=0
  263. 2720 pr$="[193]lle rel. [194]eziehungen eleminiert.": gosub 610
  264. 2730 return
  265. 2740 :
  266. 2750 rem eleminiere folgebez.
  267. 2760 :
  268. 2770 for q=1 to qm%
  269. 2780 : for e=1 to zm%
  270. 2790 :   bx%(q,e)=bw%: by%(q,e)=bw%
  271. 2800 : next e,q
  272. 2810 pr$="[193]lle [198]olgebeziehungen eleminiert.": gosub 610
  273. 2820 wi%=0
  274. 2830 return
  275. 2840 :
  276. 2850 rem decke widerspruch auf
  277. 2860 :
  278. 2870 pr$=c2$+"[215]iderspruch. [207]bjekt kann einer [199]ruppe": gosub 610
  279. 2880 pr$="nicht zugeordnet werden.": gosub 610
  280. 2890 if bx%(q,e)=0 then pr$=b$(s2%(q),e)+", "+f$(s1%(q)): gosub 610
  281. 2900 if by%(q,e)=0 then pr$=b$(s1%(q),e)+", "+f$(s2%(q)): gosub 610
  282. 2910 pr$="[203]orrektur der [197]ingangsbeziehungen": gosub 610
  283. 2920 pr$="ist erforderlich.  [194]itte warten."+c1$: gosub 610
  284. 2930 wi%=-1
  285. 2940 return
  286. 2950 :
  287. 2960 rem setze minuszeichen
  288. 2970 :
  289. 2980 a=q%(s1%,s2%)
  290. 2990 if s1%<s2% then b=z1: c=z2
  291. 3000 if s1%>s2% then b=z2: c=z1
  292. 3010 :
  293. 3020 if wi% or (bx%(a,c) and pt%(b))=0 then return
  294. 3030 bx%(a,c)=bx%(a,c) and (bw%-pt%(b))
  295. 3040 by%(a,b)=by%(a,b) and (bw%-pt%(c))
  296. 3050 if bx%(a,c)=0 then q=a: e=c: gosub 2870: bx%(a,c)=bx%(a,c) or pt%(b):return
  297. 3060 if by%(a,b)=0 then q=a: e=b: gosub 2870: by%(a,b)=by%(a,b) or pt%(c):return
  298. 3070 f%=-1: m%=m%+1
  299. 3080 if i$=ii$ then 3110
  300. 3090 if len(i$)<10 then pr$="  "+i$+left$(l$,10-len(i$)): gosub 620: goto 3120
  301. 3100 pr$="  "+i$: gosub 610
  302. 3110 pr$="            ": gosub 620
  303. 3120 pr$=b$(s1%(a),b)+"-"+b$(s2%(a),c): gosub 610: ii$=i$: return
  304. 3130 :
  305. 3140 rem stelle bez. fest
  306. 3150 :
  307. 3160 b%=0
  308. 3170 if s1%<>s2% then 3200
  309. 3180 if z1=z2 then b%=-1: return
  310. 3190 return
  311. 3200 a=q%(s1%,s2%)
  312. 3210 if s1%<s2% then b=z1: c=z2
  313. 3220 if s1%>s2% then b=z2: c=z1
  314. 3230 if (bx%(a,c) and pt%(b))=pt%(b) then b%=-1
  315. 3240 return
  316. 3250 :
  317. 3260 rem gib beziehungen aus
  318. 3270 :
  319. 3280 pr$="[197]ingangsbez. betont":gosub 610
  320. 3290 pr$="[198]olgebez. unbetont": gosub 610
  321. 3300 for q=1 to qm%
  322. 3310 : pr$=chr$(13)+c2$+f$(s2%(q))+" und "+f$(s1%(q))+c1$+chr$(13): gosub 610
  323. 3320 : for q2=1 to zm%
  324. 3330 :   pr$="  "
  325. 3340 :   for q1=1 to zm%
  326. 3350 :     if (ex%(q,q2) and pt%(q1))=0 then pr$=pr$+c2$+"- ": goto 3380
  327. 3360 :     if (bx%(q,q2) and pt%(q1))=0 then pr$=pr$+c1$+"- ": goto 3380
  328. 3370 :     pr$=pr$+"  "
  329. 3380 :   next q1
  330. 3390 :   pr$=pr$+c1$+left$(b$(s2%(q),q2),ml): gosub 610
  331. 3400 : next q2
  332. 3410 : for p=1 to ml
  333. 3420 :   pr$="  "
  334. 3430 :   for z=1 to zm%
  335. 3440 :     pr$=pr$+mid$(b$(s1%(q),z)+l$,p,1)+" "
  336. 3450 :   next z
  337. 3460 :   gosub 610
  338. 3470 : next p
  339. 3480 next q
  340. 3490 gosub 600
  341. 3500 :
  342. 3510 if ra%=0 then return
  343. 3520 for r=1 to ra%
  344. 3530 : pr$=str$(r)+". ": gosub 620
  345. 3540 : if rp%(r)=0 then pr$="<": gosub 620
  346. 3550 : if rp%(r)=-1 then pr$="#": gosub 620
  347. 3560 : if rp%(r)>0 then pr$=chr$(48+rp%(r))+"<": gosub 620
  348. 3570 : pr$=f$(ro%(r))+" ": gosub 620
  349. 3580 : pr$=b$(r1%(r,0),r1%(r,1))+",": gosub 620
  350. 3590 : pr$=b$(r2%(r,0),r2%(r,1)): gosub 610
  351. 3600 next r
  352. 3610 return
  353. 3620 :
  354. 3630 rem rechne
  355. 3640 :
  356. 3650 pr$="[210]echenvorgang:"+chr$(13): gosub 610
  357. 3660 ti$="000000"
  358. 3670 for q=1 to qm%
  359. 3680 :  for e=1 to zm%
  360. 3690 :    bx%(q,e)=bx%(q,e) and ex%(q,e)
  361. 3700 :    by%(q,e)=by%(q,e) and ey%(q,e)
  362. 3710 next e,q
  363. 3720 :
  364. 3730 m%=0: mm%=qm%*(zm%*zm%-zm%)
  365. 3740 for q=1 to qm%
  366. 3750 : for e=1 to zm%
  367. 3760 :   if bx%(q,e)=0 or by%(q,e)=0 then gosub 2870
  368. 3770 :   for b=1 to zm%
  369. 3780 :     if (bx%(q,e) and pt%(b))=0 then m%=m%+1
  370. 3790 next b,e,q
  371. 3800 if wi% then gosub 2770: return
  372. 3810 :
  373. 3820 pr$="[194]ekannt:"+str$(int(100*m%/mm%+.5))+" %": gosub 610
  374. 3830 f%=0
  375. 3840 pr$=c2$+"[197]rgaenze..."+c1$: gosub 610
  376. 3850 for q=1 to qm%
  377. 3860 : i$="q"+mid$(str$(q),2)
  378. 3870 : for y=1 to zm%
  379. 3880 :   if not fnpl(bx%(q,y)) then 3940
  380. 3890 :   x=fnlg(bx%(q,y))
  381. 3900 :   if by%(q,x)=pt%(y) then 3940
  382. 3910 :     for e=1 to zm%
  383. 3920 :       if e<>y then a=q: b=x: c=e: gosub 3020
  384. 3930 :     next e
  385. 3940 : next y
  386. 3950 : for x=1 to zm%
  387. 3960 :   if not fnpl(by%(q,x)) then 4020
  388. 3970 :   y=fnlg(by%(q,x))
  389. 3980 :   if bx%(q,y)=pt%(x) then 4020
  390. 3990 :     for e=1 to zm%
  391. 4000 :       if e<>x then a=q: b=e: c=y: gosub 3020
  392. 4010 :     next e
  393. 4020 : next x
  394. 4030 next q: if sm%<3 or wi% then 4440
  395. 4040 :
  396. 4050 pr$=c2$+"[213]ebertrage..."+c1$: gosub 610
  397. 4060 y%=1
  398. 4070 : x%=1
  399. 4080 :   q1=q%(x%,sm%-y%+1)
  400. 4090 :   for n=1 to sm%-x%-y%
  401. 4100 :     q2=q%(x%+n,sm%-y%+1)
  402. 4110 :     q3=q%(x%,x%+n)
  403. 4120 :     i$="q"+mid$(str$(q1),2)+","+mid$(str$(q2),2)+","+mid$(str$(q3),2)
  404. 4130 :     for z=1 to zm%
  405. 4140 :       v=bx%(q2,z): if v=bw% or fnpl(bx%(q1,z)) then 4180
  406. 4150 :       a=q1: c=z: for b=1 to zm%
  407. 4160 :         if (v and (bw%-by%(q3,b)))=v then gosub 3020
  408. 4170 :       next b
  409. 4180 :       v=by%(q3,z): if v=bw% or fnpl(by%(q1,z)) then 4220
  410. 4190 :       a=q1: b=z: for c=1 to zm%
  411. 4200 :         if (v and (bw%-bx%(q2,c)))=v then gosub 3020
  412. 4210 :       next c
  413. 4220 :       v=bx%(q1,z):  if v=bw% or fnpl(bx%(q2,z)) then 4260
  414. 4230 :       a=q2: c=z: for b=1 to zm%
  415. 4240 :         if (v and (bw%-bx%(q3,b)))=v then gosub 3020
  416. 4250 :       next b
  417. 4260 :       v=bx%(q3,z): if v=bw% or fnpl(by%(q2,z)) then 4300
  418. 4270 :       a=q2: b=z: for c=1 to zm%
  419. 4280 :         if (v and (bw%-bx%(q1,c)))=v then gosub 3020
  420. 4290 :       next c
  421. 4300 :       v=by%(q1,z): if v=bw% or fnpl(by%(q3,z)) then 4340
  422. 4310 :       a=q3: b=z: for c=1 to zm%
  423. 4320 :         if (v and (bw%-by%(q2,c)))=v then gosub 3020
  424. 4330 :       next c
  425. 4340 :       v=by%(q2,z):  if v=bw% or fnpl(bx%(q3,z)) then 4390
  426. 4350 :       a=q3: c=z: for b=1 to zm%
  427. 4360 :         if (v and (bw%-by%(q1,b)))=v then gosub 3020
  428. 4370 :       next b
  429. 4380 :
  430. 4390 :     next z
  431. 4400 :   next n
  432. 4410 : x%=x%+1: if x%<=sm%-y%-1 then 4080
  433. 4420 y%=y%+1: if y%<=sm%-2 then 4070
  434. 4430 :
  435. 4440 if ra%=0 or wi% then 5940
  436. 4450 pr$=c2$+"[210]elativiere..."+c1$: gosub 610
  437. 4460 for r=1 to ra%
  438. 4470 : i$="b"+mid$(str$(r),2)
  439. 4480 : q%=q%(ro%(r),r1%(r,0))
  440. 4490 : if ro%(r)<r1%(r,0) then b1%=bx%(q%,r1%(r,1))
  441. 4500 : if ro%(r)>r1%(r,0) then b1%=by%(q%,r1%(r,1))
  442. 4510 : q%=q%(ro%(r),r2%(r,0))
  443. 4520 : if ro%(r)<r2%(r,0) then b2%=bx%(q%,r2%(r,1))
  444. 4530 : if ro%(r)>r2%(r,0) then b2%=by%(q%,r2%(r,1))
  445. 4540 : if rp%(r)=-1 then 4870
  446. 4550 :
  447. 4560 : d%=rp%(r): if d%=0 then d%=1
  448. 4570 : mi%=1
  449. 4580 :   if (b1% and pt%(mi%))=0 then mi%=mi%+1: goto 4580
  450. 4590 : for e=1 to mi%+d%-1
  451. 4600 :   s1%=r2%(r,0): z1=r2%(r,1)
  452. 4610 :   s2%=ro%(r): z2=e
  453. 4620 :   gosub 2980
  454. 4630 : next e
  455. 4640 : ma%=zm%
  456. 4650 :   if (b2% and pt%(ma%))=0 then ma%=ma%-1: goto 4650
  457. 4660 : for e=zm% to ma%-d%+1 step-1
  458. 4670 :   s1%=r1%(r,0): z1=r1%(r,1)
  459. 4680 :   s2%=ro%(r): z2=e
  460. 4690 :   gosub 2980
  461. 4700 : next e
  462. 4710 :
  463. 4720 : if rp%(r)=0 then 5010
  464. 4730 : if fnpl(b1%)=0 then 4790
  465. 4740 : for e=mi%+d%+1 to zm%
  466. 4750 :   s1%=r2%(r,0): z1=r2%(r,1)
  467. 4760 :   s2%=ro%(r): z2=e
  468. 4770 :   if e<=zm% then gosub 2980
  469. 4780 : next e
  470. 4790 : if fnpl(b2%)=0 then 5010
  471. 4800 : for e=ma%-d%-1 to 1 step-1
  472. 4810 :   s1%=r1%(r,0): z1=r1%(r,1)
  473. 4820 :   s2%=ro%(r): z2=e
  474. 4830 :   if e>=1 then gosub 2980
  475. 4840 : next e
  476. 4850 : goto 5010
  477. 4860 :
  478. 4870 : for e=1 to zm%
  479. 4880 :   if e>1 then if (b1% and pt%(e-1))<>0 then 4930
  480. 4890 :   if e<zm% then if (b1% and pt%(e+1))<>0 then 4930
  481. 4900 :   s1%=r2%(r,0): z1=r2%(r,1)
  482. 4910 :   s2%=ro%(r): z2=e
  483. 4920 :   gosub 2980
  484. 4930 : next e
  485. 4940 : for e=1 to zm%
  486. 4950 :   if e>1 then if (b2% and pt%(e-1))<>0 then 5000
  487. 4960 :   if e<zm% then if (b2% and pt%(e+1))<>0 then 5000
  488. 4970 :   s1%=r1%(r,0): z1=r1%(r,1)
  489. 4980 :   s2%=ro%(r): z2=e
  490. 4990 :   gosub 2980
  491. 5000 : next e
  492. 5010 next r
  493. 5020 :
  494. 5030 rem bilde #-ketten
  495. 5040 :
  496. 5050 for r=1 to sm%: ko%(r)=0: next r
  497. 5060 k1%=zm%+1: k2%=zm%
  498. 5070 kf%=0: for r=1 to ra%
  499. 5080 : if rp%(r)<>-1 then 5580
  500. 5090 : if k1%-1<k2% then 5140
  501. 5100 : ro%=ro%(r): if ko%(ro%)=-1 then 5580
  502. 5110 : ko%(ro%)=-1
  503. 5120 : k1%=k1%-1: k%(k1%,0)=r1%(r,0): k%(k1%,1)=r1%(r,1)
  504. 5130 : k2%=k2%+1: k%(k2%,0)=r2%(r,0): k%(k2%,1)=r2%(r,1): goto 5580
  505. 5140 : if ro%(r)<>ro% then 5580
  506. 5150 :
  507. 5160 : s1%=r1%(r,0): z1=r1%(r,1)
  508. 5170 : s2%=k%(k1%,0): z2=k%(k1%,1)
  509. 5180 : gosub 3160 beziehung b%
  510. 5190 : if b%=0 then 5260
  511. 5200 : s1%=r2%(r,0): z1=r2%(r,1)
  512. 5210 : s2%=k%(k1%+1,0): z2=k%(k1%+1,1)
  513. 5220 : gosub 3160 beziehung b%
  514. 5230 : if b%<>0 then 5260
  515. 5240 : k1%=k1%-1: p%=k1%: goto 5570 r2% am anfang anfuegen
  516. 5250 :
  517. 5260 : s1%=r2%(r,0): z1=r2%(r,1)
  518. 5270 : s2%=k%(k1%,0): z2=k%(k1%,1)
  519. 5280 : gosub 3160 beziehung b%
  520. 5290 : if b%=0 then 5360
  521. 5300 : s1%=r1%(r,0): z1=r1%(r,1)
  522. 5310 : s2%=k%(k1%+1,0): z2=k%(k1%+1,1)
  523. 5320 : gosub 3160 beziehung b%
  524. 5330 : if b%<>0 then 5360
  525. 5340 : k1%=k1%-1: p%=k1%: goto 5560 r1% am anfang anfuegen
  526. 5350 :
  527. 5360 : s1%=r1%(r,0): z1=r1%(r,1)
  528. 5370 : s2%=k%(k2%,0): z2=k%(k2%,1)
  529. 5380 : gosub 3160 beziehung b%
  530. 5390 : if b%=0 then 5460
  531. 5400 : s1%=r2%(r,0): z1=r2%(r,1)
  532. 5410 : s2%=k%(k2%-1,0): z2=k%(k2%-1,1)
  533. 5420 : gosub 3160 beziehung b%
  534. 5430 : if b%<>0 then 5460
  535. 5440 : k2%=k2%+1: p%=k2%: goto 5570 r2% am ende anfuegen
  536. 5450 :
  537. 5460 : s1%=r2%(r,0): z1=r2%(r,1)
  538. 5470 : s2%=k%(k2%,0): z2=k%(k2%,1)
  539. 5480 : gosub 3160 beziehung b%
  540. 5490 : if b%=0 then 5580 next
  541. 5500 : s1%=r1%(r,0): z1=r1%(r,1)
  542. 5510 : s2%=k%(k2%-1,0): z2=k%(k2%-1,1)
  543. 5520 : gosub 3160 beziehung b%
  544. 5530 : if b%<>0 then 5580 next
  545. 5540 : k2%=k2%+1: p%=k2%: goto 5560 r1% am ende anfuegen
  546. 5550 :
  547. 5560 : kf%=-1: k%(p%,0)=r1%(r,0): k%(p%,1)=r1%(r,1): goto 5580
  548. 5570 : kf%=-1: k%(p%,0)=r2%(r,0): k%(p%,1)=r2%(r,1)
  549. 5580 next r
  550. 5590 if kf% then 5070
  551. 5600 if k1%+2>k2% then 5940
  552. 5610 i$="#"+f$(ro%)+" "
  553. 5620 for i=k1% to k2%
  554. 5630 : i$=i$+b$(k%(i,0),k%(i,1))
  555. 5640 : if i<>k2% then i$=i$+","
  556. 5650 next i
  557. 5660 for i=k1% to k2%
  558. 5670 : kb%(i)=0
  559. 5680 next i
  560. 5690 for p=1 to zm%-(k2%-k1%)
  561. 5700 : for i=k1% to k2%
  562. 5710 :   s1%=k%(i,0): z1=k%(i,1)
  563. 5720 :   s2%=ro%    : z2=p+i-k1%
  564. 5730 :   gosub 3160 beziehung b%
  565. 5740 :   if b%<>0 then kb%(i)=kb%(i) or pt%(p+i-k1%)
  566. 5750 : next i
  567. 5760 : for i=k2% to k1% step-1
  568. 5770 :   s1%=k%(i,0): z1=k%(i,1)
  569. 5780 :   s2%=ro%    : z2=p+k2%-i
  570. 5790 :   gosub 3160 beziehung b%
  571. 5800 :   if b%<>0 then kb%(i)=kb%(i) or pt%(p+k2%-i)
  572. 5810 : next i
  573. 5820 next p
  574. 5830 :
  575. 5840 for i=k1% to k2%
  576. 5850 : for z=1 to zm%
  577. 5860 :   if (kb%(i) and pt%(z))<>0 then 5900
  578. 5870 :   s1%=k%(i,0): z1=k%(i,1)
  579. 5880 :   s2%=ro%: z2=z
  580. 5890 :   gosub 2980 lege bez. fest
  581. 5900 : next z
  582. 5910 next i
  583. 5920 goto 5060
  584. 5930 :
  585. 5940 if wi%=0 and f%=-1 and m%<mm% then 3820
  586. 5950 if wi% then gosub 2770: return
  587. 5960 pr$=chr$(13)+"[210]echenzeit: "+mid$(ti$,3,2)+":"+mid$(ti$,5,2)+" min"+chr$(13)
  588. 5970 gosub 610
  589. 5980 if m%=mm% then gosub 6040 gib tabelle
  590. 5990 if m%<mm% then pr$="[201]nformationen reichen nicht.": gosub 610
  591. 6000 return
  592. 6010 :
  593. 6020 rem gib a-tabelle
  594. 6030 :
  595. 6040 pr$="[176]": for i=1 to sm%-1: pr$=pr$+w$+"[178]": next: pr$=pr$+w$+"[174]":gosub 610
  596. 6050 pr$="[221]": for s=1 to sm%: p$=f$(s): gosub 6200: next s: gosub 610
  597. 6060 pr$="[171]": for i=1 to sm%-1: pr$=pr$+w$+"[219]": next: pr$=pr$+w$+"[179]":gosub 610
  598. 6070 for z=1 to zm%
  599. 6080 : pr$="[221]": p$=b$(1,z):gosub 6200
  600. 6090 : for s=2 to sm%
  601. 6100 :   s1%=1  : z1=z: s2%=s :z2=0
  602. 6110 :   q%=q%(s1%,s2%)
  603. 6120 :   if fnpl(by%(q%,z1)) then p$=b$(s2%(q%),fnlg(by%(q%,z1))): goto 6140
  604. 6130 :   p$="?"
  605. 6140 :   gosub 6200
  606. 6150 : next s: gosub 610
  607. 6160 next z
  608. 6170 pr$="[173]": for i=1 to sm%-1: pr$=pr$+w$+"[177]": next: pr$=pr$+w$+"[189]": gosub610
  609. 6180 return
  610. 6190 :
  611. 6200 pr$=pr$+c2$+left$(p$+l$,ml)+c1$+"[221]": return
  612. 6210 :
  613. 6220 rem gib befehlstabelle
  614. 6230 :
  615. 6240 pr$="[194]efehlssyntax"+chr$(13): gosub 610
  616. 6250 pr$="[193]bsolute [194]eziehungen definieren": gosub 610
  617. 6260 pr$=c2$+"      a-b"+c1$+"  negative [194]ez. herstellen": gosub 610
  618. 6270 pr$=c2$+"      a?b"+c1$+"  [194]ez. doch offen lassen": gosub 610
  619. 6280 pr$=c2$+"      a+b"+c1$+"  kreuzweise neg. [194]ez.": gosub 610
  620. 6290 gosub 600
  621. 6300 pr$="[210]elative [194]eziehungen (hinsichtlich": gosub 610
  622. 6310 pr$="[207]berbegriff o) definieren": gosub 610
  623. 6320 pr$=c2$+"   <o a,b"+c1$+"  objekt a liegt vor objekt b": gosub 610
  624. 6330 pr$=c2$+"  n<o a,b"+c1$+"  a liegt n [208]laetze vor b": gosub 610
  625. 6340 pr$=c2$+"   #o a,b"+c1$+"  a und b nebeneinander": gosub 610
  626. 6350 pr$=chr$(13)+"[193]llgemeine [194]efehle": gosub 610
  627. 6360 pr$=c2$+"  neu=alt"+c1$+"  [194]egriff umbennen": gosub 610
  628. 6370 pr$=c2$+"        o"+c1$+"  [207]bjekte ausgeben": gosub 610
  629. 6380 pr$=c2$+"        t"+c1$+"  [193]-[212]abelle ausgeben": gosub 610
  630. 6390 pr$=c2$+"        b"+c1$+"  alle [194]eziehungen ausgeben": gosub 610
  631. 6400 pr$=c2$+"       @f"+c1$+"  [198]olgebez. eleminieren": gosub 610
  632. 6410 pr$=c2$+"       @r"+c1$+"  [210]elative [194]ez. eleminieren": gosub 610
  633. 6420 pr$=c2$+"        l"+c1$+"  [204]aden von [196]iskette": gosub 610
  634. 6430 pr$=c2$+"        s"+c1$+"  [211]peichern auf [196]iskette": gosub 610
  635. 6440 pr$=c2$+"        r"+c1$+"  [210]echnen": gosub 610
  636. 6450 return
  637. 6460 :
  638. 6470 rem hauptprogramm
  639. 6480 :
  640. 6490 gosub 830 dimensioniere
  641. 6500 c1$=chr$(158): c2$=chr$(5)
  642. 6510 poke 53281,11: poke 53280,0
  643. 6520 print chr$(8);chr$(14);c1$;chr$(147)
  644. 6530 pr$="[208]ower of [204]ogic": gosub 610
  645. 6540 pr$="[214]ersion 1.01": gosub 610
  646. 6550 pr$=c2$: gosub 610
  647. 6560 pr$="[195]opyright ([195]) 1992": gosub 610
  648. 6570 pr$="[205]arkt & [212]echnik [214]erlag [193][199]": gosub 610
  649. 6580 pr$="[214]on [201]ngolf [204]ange": gosub 610
  650. 6590 pr$=c1$+chr$(13): gosub 610
  651. 6600 :
  652. 6610 pr$="[215]ollen [211]ie eine [212]abelle": gosub 610
  653. 6620 pr$="laden(l) oder eingeben(e)? ": gosub 620
  654. 6630 get i$: if i$<>"l" and i$<>"e" then 6630
  655. 6640 pr$=i$: gosub 610
  656. 6650 if i$="l" then gosub 1480: goto 6670
  657. 6660 if i$="e" then gosub 1730
  658. 6670 pr$=chr$(13): gosub 610
  659. 6680 pr$="[194]itte jetzt alle bekannten": gosub 610
  660. 6690 pr$="[194]eziehungen zwischen den gesammelten": gosub 610
  661. 6700 pr$="[207]bjekten eingeben. [196]er [194]efehlssyntax": gosub 610
  662. 6710 pr$="wird mit <[210][197][212][213][210][206]> aufgelistet.": gosub 610
  663. 6720 gosub 600: pr$=">": gosub 620
  664. 6730 gosub 420
  665. 6740 if i$=""  then gosub 6240: goto 6720
  666. 6750 if i$="o" then gosub 2230: goto 6720
  667. 6760 if i$="b" then gosub 3280: goto 6720
  668. 6770 if i$="l" then gosub 1480: goto 6720
  669. 6780 if i$="@f" then gosub 2770: goto 6720
  670. 6790 if i$="@r" then gosub 2710: goto 6720
  671. 6800 if i$="s" then gosub 1230: goto 6720
  672. 6810 if i$="r" then gosub 3650: goto 6720
  673. 6820 if i$="t" then gosub 6040: goto 6720
  674. 6830 if len(i$)<3 then pr$=c2$+"[198]alsche [197]ingabe."+c1$: gosub 610: goto 6730
  675. 6840 i%=1
  676. 6850 k$=mid$(i$,i%,1)
  677. 6860 if k$="+" then gosub 7060: gosub 2340: goto 6720
  678. 6870 if k$="-" then gosub 7060: gosub 2340: goto 6720
  679. 6880 if k$="?" then gosub 7060: gosub 2340: goto 6720
  680. 6890 if k$="=" then gosub 7060: gosub 2120: goto 6720
  681. 6900 if k$="<" then 6940
  682. 6910 if k$="#" then rp%=-1: goto 6960
  683. 6920 i%=i%+1: if i%<len(i$) then 6850
  684. 6930 pr$=c2$+"[194]efehl nicht erkannt."+c1$: gosub 610: goto 6720
  685. 6940 if i%=1 then rp%=0
  686. 6950 if i%>1 then rp%=val(left$(i$,i%-1))
  687. 6960 ro%=0: i%=i%+1
  688. 6970 for o=1 to sm%
  689. 6980 : if mid$(i$,i%,len(f$(o))+1)=f$(o)+" " then ro%=o
  690. 6990 next o
  691. 7000 if ro%=0 then pr$=c2$+"[207]rdnungskriterium nicht erkannt."+c1$:gosub610:goto 6720
  692. 7010 i$=mid$(i$,i%+len(f$(ro%))+1): i%=1
  693. 7020 if mid$(i$,i%,1)="," then gosub 7060: gosub 2340: goto 6720
  694. 7030 i%=i%+1: if i%<=len(i$) then 7020
  695. 7040 pr$=c2$+"[203]omma fehlt."+c1$: gosub 610: goto 6720
  696. 7050 :
  697. 7060 a$=mid$(i$,1,i%-1): b$=mid$(i$,i%+1,len(i$)-i%): return
  698.